Il Mio Computer 2006 May/Mico05CD.bin/Internet/VisualIRC/virc200.exe/{app}/Scripts/slidegame.vsc

Text File | 2003-05-16 | 11.5 KB | 396 lines

// Written at 1/19/2002 8:53:46 PM
//@RBL_BEGIN   # Do not move or change this line
@ $SlideForm = $new(TForm position 281,79,209,258)
@p $SlideForm.BorderIcons = [biSystemMenu]
@p $SlideForm.BorderStyle = bsSingle
@p $SlideForm.Caption = Slide Game
@p $SlideForm.ClientHeight = 231
@p $SlideForm.ClientWidth = 201
@p $SlideForm.Color = clBtnFace
@p $SlideForm.Font.Charset = 1
@p $SlideForm.Font.Color = clWindowText
@p $SlideForm.Font.Name = MS Sans Serif
@p $SlideForm.Font.Style = []
@p $SlideForm.FormStyle = fsStayOnTop
@p $SlideForm.OldCreateOrder = False
@p $SlideForm.ShowHint = True
@p $SlideForm.Visible = True
@p $SlideForm.OnClose = _SlideForm_Close
@p $SlideForm.OnDestroy = _SlideForm_Destroy
@ $Button1 = $new(TButton ownedby $SlideForm position 8,8,41,41)
@p $Button1.Caption = Button1
@p $Button1.TabOrder = 1
@p $Button1.OnClick = _ButtonN_Click
@ $Button2 = $new(TButton ownedby $SlideForm position 56,8,41,41)
@p $Button2.Caption = Button2
@p $Button2.TabOrder = 2
@p $Button2.OnClick = _ButtonN_Click
@ $Button3 = $new(TButton ownedby $SlideForm position 104,8,41,41)
@p $Button3.Caption = Button3
@p $Button3.TabOrder = 3
@p $Button3.OnClick = _ButtonN_Click
@ $Button4 = $new(TButton ownedby $SlideForm position 152,8,41,41)
@p $Button4.Caption = Button4
@p $Button4.TabOrder = 4
@p $Button4.OnClick = _ButtonN_Click
@ $Button5 = $new(TButton ownedby $SlideForm position 8,56,41,41)
@p $Button5.Caption = Button5
@p $Button5.TabOrder = 5
@p $Button5.OnClick = _ButtonN_Click
@ $Button6 = $new(TButton ownedby $SlideForm position 56,56,41,41)
@p $Button6.Caption = Button6
@p $Button6.TabOrder = 6
@p $Button6.OnClick = _ButtonN_Click
@ $Button7 = $new(TButton ownedby $SlideForm position 104,56,41,41)
@p $Button7.Caption = Button7
@p $Button7.TabOrder = 7
@p $Button7.OnClick = _ButtonN_Click
@ $Button8 = $new(TButton ownedby $SlideForm position 152,56,41,41)
@p $Button8.Caption = Button8
@p $Button8.TabOrder = 8
@p $Button8.OnClick = _ButtonN_Click
@ $Button9 = $new(TButton ownedby $SlideForm position 8,104,41,41)
@p $Button9.Caption = Button9
@p $Button9.TabOrder = 9
@p $Button9.OnClick = _ButtonN_Click
@ $ShuffleButton = $new(TButton ownedby $SlideForm position 8,200,89,25)
@p $ShuffleButton.Caption = Shuffle
@p $ShuffleButton.TabOrder = 10
@p $ShuffleButton.OnClick = _ShuffleButton_Click
@ $Button10 = $new(TButton ownedby $SlideForm position 56,104,41,41)
@p $Button10.Caption = Button10
@p $Button10.TabOrder = 11
@p $Button10.OnClick = _ButtonN_Click
@ $Button11 = $new(TButton ownedby $SlideForm position 104,104,41,41)
@p $Button11.Caption = Button11
@p $Button11.TabOrder = 12
@p $Button11.OnClick = _ButtonN_Click
@ $Button12 = $new(TButton ownedby $SlideForm position 152,104,41,41)
@p $Button12.Caption = Button12
@p $Button12.TabOrder = 13
@p $Button12.OnClick = _ButtonN_Click
@ $Button13 = $new(TButton ownedby $SlideForm position 8,152,41,41)
@p $Button13.Caption = Button13
@p $Button13.TabOrder = 14
@p $Button13.OnClick = _ButtonN_Click
@ $Button14 = $new(TButton ownedby $SlideForm position 56,152,41,41)
@p $Button14.Caption = Button14
@p $Button14.TabOrder = 15
@p $Button14.OnClick = _ButtonN_Click
@ $Button15 = $new(TButton ownedby $SlideForm position 104,152,41,41)
@p $Button15.Caption = Button15
@p $Button15.TabOrder = 16
@p $Button15.OnClick = _ButtonN_Click
@ $Button16 = $new(TButton ownedby $SlideForm position 152,152,41,41)
@p $Button16.Caption = Button16
@p $Button16.TabOrder = 17
@p $Button16.OnClick = _ButtonN_Click
@ $CodeBtn = $new(TButton ownedby $SlideForm position 104,200,89,25)
@p $CodeBtn.Hint = Click to enter a puzzle code
@p $CodeBtn.Caption = CodeBtn
@p $CodeBtn.TabOrder = 18
@p $CodeBtn.OnClick = _CodeBtn_Click
//@RBL_END   # Do not move or change this line
// set up $Buttons[row,col]
@ $Buttons[1,1] = $Button1
@ $Buttons[1,2] = $Button2
@ $Buttons[1,3] = $Button3
@ $Buttons[1,4] = $Button4
@ $Buttons[2,1] = $Button5
@ $Buttons[2,2] = $Button6
@ $Buttons[2,3] = $Button7
@ $Buttons[2,4] = $Button8
@ $Buttons[3,1] = $Button9
@ $Buttons[3,2] = $Button10
@ $Buttons[3,3] = $Button11
@ $Buttons[3,4] = $Button12
@ $Buttons[4,1] = $Button13
@ $Buttons[4,2] = $Button14
@ $Buttons[4,3] = $Button15
@ $Buttons[4,4] = $Button16

Alias Slide_Disorder
   @l $disorder = 0
   @l $pattern = $1-
   // don't count the space (16)
   for (@l $i = 0; $i < 16; $i++)
     continue if $listindex($i $pattern) == 16
     for (@l $j = $($i + 1); $j < 16; $j++)
       continue if $listindex($j $pattern) == 16
       // if pattern[$i] > pattern [$j], this pair is disordered
       if $listindex($i $pattern) > $listindex($j $pattern)
         $disorder++
       endif
     endfor
   endfor
   @ $fresult = $disorder
EndAlias

// Event parameters: $Sender
Alias _ShuffleButton_Click
   @ $Slide_Moves = 0
   @l $doshuffle = 1
   while $doshuffle
     // space always comes last
     @l $pattern = $listshuffle(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) 16
     // measure disorder
     @l $disorder = $slide_disorder($pattern)
     //TOS clBlue Disorder: $disorder
     if ($disorder % 2) == 0
       // even disorder - solvable
       @l $doshuffle = 0
     endif
   endwhile
   if $Slide_FPU_DLL != 0
     @p $CodeBtn.Caption = $Slide_PatternToCode($listremove(16 $pattern))
   endif
   // BUG - " " should work, not double-quoted <" ">
   @l $pattern = $listsearchreplace(16 <" "> $pattern)
   //TOS clGreen $pattern
   @l $idx = 0
   for (@l $i = 1; $i <= 4; $i++)
     for (@l $j = 1; $j <= 4; $j++)
       @l $x = $Buttons[$i,$j]
       @p $x.Caption = $listindex($idx $pattern)
       $idx++
     endfor
   endfor
EndAlias

Alias Slide_GetPattern
   @l $pattern = $null
   for (@l $row = 1; $row <= 4; $row++)
     for (@l $col = 1; $col <= 4; $col++)
       @l $btn = $Buttons[$row,$col]
       if [$prop($btn.Caption)] == [ ]
         @l $num = 16
       else
         @l $num = $prop($btn.Caption)
       endif
       @l $pattern = $pattern $num
     endfor
   endfor
   @ $fresult = $substr($pattern 2 99999)
EndAlias

// Event parameters: $Sender
Alias _ButtonN_Click
   // find button's coordinates
   @l $coords = $null
   foreach ($key,$value; $Buttons)
     if $value == $Sender
       @l $coords = $key
       break
     endif
   endforeach
   Halt if [$coords] == []

   @l $row = $strtokl(, $coords)
   @l $col = $strtokr(, $coords)

   @l $hole = $slide_findhole($row $col)
   if [$hole] == []
     Beep
     Halt
   endif

   $Slide_Moves++

   // swap captions
   @l $thiscaption = $prop($Sender.Caption)
   @l $that = $Buttons[$hole]
   @l $thatcaption = $prop($that.Caption)

   @p $Sender.Caption = $thatcaption
   @p $that.Caption = $thiscaption

   //TOS clBlue Disorder is now $slide_disorder($slide_getpattern())

   // check if solved
   Slide_CheckSolve
EndAlias

// Event parameters: $Sender, $Action (returned)
Alias _SlideForm_Close
   @l $Action = caFree
EndAlias

Alias Slide_FindHole
   @l $row = $1
   @l $col = $2
   @l $check = $($row-1),$col $($row+1),$col $row,$($col-1) $row,$($col+1)

   foreach ($i; $check)
     @l $btn = $Buttons[$i]
     continue if [$btn] == []
     @l $caption = $prop($btn.Caption)
     if [$caption] == [ ]
       @ $fresult = $i
       Halt
     endif
   endforeach

   @ $fresult = $null
EndAlias

Alias Slide_CheckSolve
   @l $expect = 1
   for (@l $row = 1; $row <= 4; $row++)
     //TOS clblack row $row
     for (@l $col = 1; $col <= 4; $col++)
       @l $btn = $Buttons[$row,$col]
       //TOS clblack col $col, btn $btn, expecting [$expect]
       if [$prop($btn.Caption)] != [$expect]
         // didn't win
         //messagebox no win
         Halt
       endif
       // find next expected caption
       if $expect == 15
         // expect a space
         @l $expect = $null $null
       else
         $expect++
       endif
     endfor
   endfor

   // must have won
   ^mtimer 100 5 beep
   MessageBox You have won in $Slide_Moves moves.
EndAlias

// Event parameters: $Sender
Alias _SlideForm_Destroy
   if $Slide_FPU_DLL != 0
     FreeDLL $Slide_FPU_DLL
   endif
EndAlias

// fake int64 math using fpu.dll
Alias _sladd
   @ $fresult = $fadd($1 $2)
EndAlias

Alias _slmul
   @ $fresult = $fmul($1 $2)
EndAlias

Alias _sldiv
   @ $fresult = $strtokl(. $fdiv($1 $2))
EndAlias

Alias _slmod
   @ $fresult = $fsub($1 $fmul($_sldiv($1 $2) $2))
EndAlias

// doesn't use letters "I" or "O" to avoid confusion
@ $Slide_CodeLetters = 0 1 2 3 4 5 6 7 8 9 A B C D E F G H J K L M N P Q R S T U V W X Y Z

Alias _slltr2val
   @ $fresult = $listindexof($1 $Slide_CodeLetters)
EndAlias

Alias _slval2ltr
   @ $fresult = $listindex($1 $Slide_CodeLetters)
EndAlias

// stored patterns only have 15 values (space is always at the end)
Alias Slide_CodeToPattern
   // build integer code
   @l $code = 0
   @l $len = $length($1)
   for (@l $i = 1; $i <= $len; $i++)
     @l $code = $_sladd($_slmul($code 34) $_slltr2val($substr($1 $i 1)))
   endfor

   // list of tiles left to assign
   @l $tiles = 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

   @l $pattern = $null
   for (@l $i = 15; $i >= 1; $i--)
     @l $btn = $Buttons[$row,$col]
     @l $choice = $_slmod($code $i)
     @l $code = $_sldiv($code $i)
     @l $pattern = $listcat($listindex($choice $tiles) $pattern)
     @l $tiles = $listdelete($choice $tiles)
   endfor

   @ $fresult = $pattern
EndAlias

Alias Slide_PatternToCode
   @l $pattern = $1-

   // list of tiles left to find
   @l $tiles = 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
   // array of saved choices
   @l $choices = $null

   for (@l $i = 14; $i >= 0; $i--)
     @l $value = $listindex($i $pattern)
     @l $choice = $listindexof($value $tiles)
     //TOS clGreen i=$i value="$value" choice="$choice" tiles="$tiles"
     @l $choices[$i] = $choice
     @l $tiles = $listremove($value $tiles)
   endfor

   // build integer code
   @l $code = 0
   for (@l $i = 0; $i <= 14; $i++)
   //TOS clBlue i=$i code is $code
     @l $code = $_sladd($_slmul($code $($i+1)) $choices[$i])
   endfor

   // change to letters
   @l $codestr = $null
   while [$code] != [0]
     @l $codestr = $_slval2ltr($_slmod($code 34))$codestr
     @l $code = $_sldiv($code 34)
   endwhile
   while $length($codestr) < 8
     @l $codestr = 0$codestr
   endwhile

   @ $fresult = $codestr
EndAlias

// Event parameters: $Sender
Alias _CodeBtn_Click
   @l $code = $?="Enter the code of a game to play:|$prop($CodeBtn.Caption)"
   Halt if [$code] == [INPUT_CANCELLED]
   if $length($code) != 8
     MessageBox The code must be 8 characters.
     Halt
   endif

   @l $pattern = $listcat($Slide_CodeToPattern($code) 16)
   @l $disorder = $Slide_Disorder($pattern)
   if ($disorder % 2) == 1
     @l $ret = $messagedlg(52 The game you've chosen cannot be solved. Are you sure you want to try anyway?)
     Halt if $ret == 7
   endif

   @l $pattern = $listsearchreplace(16 <" "> $pattern)
   @l $idx = 0
   for (@l $row = 1; $row <= 4; $row++)
     for (@l $col = 1; $col <= 4; $col++)
       @l $btn = $Buttons[$row,$col]
       @p $btn.Caption = $listindex($idx $pattern)
       $idx++
     endfor
   endfor

   @p $CodeBtn.Caption = $upper($code)
EndAlias

// need fpu.dll for the code button
@ $Slide_FPU_DLL = $LoadDLL(fpu.dll)
if $Slide_FPU_DLL == 0
  @p $CodeBtn.Enabled = False
  @p $CodeBtn.Hint = Need fpu.dll for code entry
endif

_ShuffleButton_Click